home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 2005 July / DPPCPRO0705.ISO / Editorial / Delphi 2005 / VCLEditor / Editor.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2005-03-23  |  19.9 KB  |  723 lines
  1. unit Editor;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, ToolWin, ComCtrls, StdCtrls,
  8.   ImgList;
  9.  
  10. type
  11.   TResponse = (yes, no, cancel, nothing);
  12.  
  13.  
  14.   TMainForm = class(TForm)
  15.     EditWin: TRichEdit;
  16.     MainMenu1: TMainMenu;
  17.     FileMenu: TMenuItem;
  18.     OpenMenuItem: TMenuItem;
  19.     NewMenuItem: TMenuItem;
  20.     N1: TMenuItem;
  21.     SaveMenuItem: TMenuItem;
  22.     SaveAsMenuItem: TMenuItem;
  23.     N2: TMenuItem;
  24.     ExitMenuItem: TMenuItem;
  25.     EditMenu: TMenuItem;
  26.     FindMenuItem: TMenuItem;
  27.     ReplaceMenuItem: TMenuItem;
  28.     UndoMenuItem: TMenuItem;
  29.     ToolBar1: TToolBar;
  30.     StatusBar: TStatusBar;
  31.     OpenDialog: TOpenDialog;
  32.     SaveDialog: TSaveDialog;
  33.     CutMenuItem: TMenuItem;
  34.     CopyMenuItem: TMenuItem;
  35.     PasteMenuItem: TMenuItem;
  36.     N3: TMenuItem;
  37.     FontCombo: TComboBox;
  38.     ShowFontStylesCB: TCheckBox;
  39.     BoldBtn: TToolButton;
  40.     ItalicBtn: TToolButton;
  41.     ULineBtn: TToolButton;
  42.     ToolIconsImageList: TImageList;
  43.     ReplaceDialog: TReplaceDialog;
  44.     FindDialog: TFindDialog;
  45.     FontDialog: TFontDialog;
  46.     FormatMenu: TMenuItem;
  47.     FontMenuItem: TMenuItem;
  48.     FontSizeCombo: TComboBox;
  49.     ColourCombo: TComboBox;
  50.     procedure NewMenuItemClick(Sender: TObject);
  51.     procedure FormCreate(Sender: TObject);
  52.     procedure OpenMenuItemClick(Sender: TObject);
  53.     procedure ExitMenuItemClick(Sender: TObject);
  54.     procedure SaveMenuItemClick(Sender: TObject);
  55.     procedure SaveAsMenuItemClick(Sender: TObject);
  56.     procedure CutMenuItemClick(Sender: TObject);
  57.     procedure CopyMenuItemClick(Sender: TObject);
  58.     procedure PasteMenuItemClick(Sender: TObject);
  59.     procedure UndoMenuItemClick(Sender: TObject);
  60.     procedure FontComboDrawItem(Control: TWinControl; Index: Integer;
  61.       Rect: TRect; State: TOwnerDrawState);
  62.     procedure ShowFontStylesCBClick(Sender: TObject);
  63.     procedure FontComboChange(Sender: TObject);
  64.     procedure EditWinSelectionChange(Sender: TObject);
  65.     procedure BoldBtnClick(Sender: TObject);
  66.     procedure ItalicBtnClick(Sender: TObject);
  67.     procedure ULineBtnClick(Sender: TObject);
  68.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  69.     procedure FindMenuItemClick(Sender: TObject);
  70.     procedure ReplaceMenuItemClick(Sender: TObject);
  71.     procedure ReplaceDialogReplace(Sender: TObject);
  72.     procedure FindDialogFind(Sender: TObject);
  73.     procedure FontMenuItemClick(Sender: TObject);
  74.     procedure FontSizeComboClick(Sender: TObject);
  75.     procedure FontSizeComboExit(Sender: TObject);
  76.     procedure FontSizeComboKeyUp(Sender: TObject; var Key: Word;
  77.       Shift: TShiftState);
  78.     procedure FontSizeComboKeyPress(Sender: TObject; var Key: Char);
  79.     procedure EditWinKeyUp(Sender: TObject; var Key: Word;
  80.       Shift: TShiftState);
  81.     procedure ColourComboDrawItem(Control: TWinControl; Index: Integer;
  82.       Rect: TRect; State: TOwnerDrawState);
  83.     procedure ColourComboChange(Sender: TObject);
  84.     procedure EditWinKeyPress(Sender: TObject; var Key: Char);
  85.   private
  86.     { Private declarations }
  87.     FFileName : string;
  88.     // --- Save and Close
  89.     procedure SetFileName( fn : string );
  90.     procedure ClearEditWin;
  91.     procedure DoSaveFile;
  92.     function  ConfirmFileSave( fn, msg : string) : TResponse;
  93.     function OKtoCloseCurrentDoc : boolean;
  94.     function SaveFileAs : TResponse;
  95.     function SaveFile : TResponse;
  96.     // --- Fonts and character styles
  97.     procedure UpdateFontDisplay;
  98.     procedure ToggleBold;
  99.     procedure ToggleItalic;
  100.     procedure ToggleULine;
  101.     // --- Find and Replace routines
  102.     function StrFoundAt( dlg : TFindDialog; Opts : TSearchTypes ) : LongInt;
  103.     procedure FindStr( dlg : TFindDialog );
  104.     function ReplaceStr( dlg : TReplaceDialog ) : boolean;
  105.     function SearchOptions( dlg : TFindDialog ) : TSearchTypes;
  106.     // ------------------------------
  107.   public
  108.     { Public declarations }
  109.   end;
  110.  
  111. // ColourID record
  112.    ColourID = record
  113.       Value : integer;
  114.       Name : string;
  115.    end;
  116.  
  117. var
  118.   MainForm: TMainForm;
  119.  
  120. const
  121.    NEWFILENAME = 'Untitled';
  122.    APPNAME = 'Delphi Text Editor';
  123.  
  124.    FILEOVERWRITEMSG = '%s already exists. OK to overwrite?';
  125.    FILESAVEMSG = 'Save changes to %s?';
  126.  
  127. // typed constant - array of standard font sizes
  128.    FONTSIZES : array[0..14] of integer =
  129.                (8,9,10,11,12,16,18,20,22,24,26,28,36,48,72);
  130.  
  131. // Lists the common colour constants. These will be used to init the
  132. // ColourCombo - NOTE: some routines assume that items in the array
  133. // and the combo are identical
  134.  Colours: array[0..15] of ColourID = (
  135.     (Value: clBlack; Name: 'clBlack'),
  136.     (Value: clMaroon; Name: 'clMaroon'),
  137.     (Value: clGreen; Name: 'clGreen'),
  138.     (Value: clOlive; Name: 'clOlive'),
  139.     (Value: clNavy; Name: 'clNavy'),
  140.     (Value: clPurple; Name: 'clPurple'),
  141.     (Value: clTeal; Name: 'clTeal'),
  142.     (Value: clGray; Name: 'clGray'),
  143.     (Value: clSilver; Name: 'clSilver'),
  144.     (Value: clRed; Name: 'clRed'),
  145.     (Value: clLime; Name: 'clLime'),
  146.     (Value: clYellow; Name: 'clYellow'),
  147.     (Value: clBlue; Name: 'clBlue'),
  148.     (Value: clFuchsia; Name: 'clFuchsia'),
  149.     (Value: clAqua; Name: 'clAqua'),
  150.     (Value: clWhite; Name: 'clWhite'));
  151.  
  152. // some space chars used to display colour in colourcombo
  153. COLOURBLOB = '     ';
  154.  
  155. // ==========================================================================
  156. implementation
  157. // ==========================================================================
  158.  
  159. {$R *.DFM}
  160. //--------------------------
  161. // --- Save/Load Routines
  162. //--------------------------
  163. function TMainForm.ConfirmFileSave( fn, msg : string ) : TResponse;
  164. var
  165.   savechoice : integer;
  166. begin
  167.   begin
  168.     savechoice := MessageDlg(Format(FILESAVEMSG, [ExtractFileName(fn)]),
  169.       mtConfirmation, mbYesNoCancel, 0);
  170.     case savechoice of
  171.       idYes: result := yes;
  172.       idNo: result := no;
  173.       idCancel: result := cancel;
  174.       else result := nothing;
  175.     end;
  176.    end
  177. end;
  178.  
  179. function TMainForm.OKtoCloseCurrentDoc : boolean;
  180. var
  181.    doclose, dosave : TResponse;
  182. begin
  183.    doclose := yes;
  184.    dosave := no;
  185.    if EditWin.Modified then
  186.    case ConfirmFileSave( FFileName, FILESAVEMSG ) of
  187.       yes: dosave := SaveFile;
  188.       no, nothing : { do nothing } ;
  189.       cancel : doclose := no;
  190.    end;
  191.    if (doclose = yes) and (dosave <> cancel) then
  192.       result := true
  193.    else
  194.       result := false;
  195. end;
  196.  
  197.  
  198. procedure TMainForm.DoSaveFile;
  199. begin
  200.   EditWin.Lines.SaveToFile(FFileName);
  201.   EditWin.Modified := False;
  202. end;
  203.  
  204.  
  205. function TMainForm.SaveFileAs : TResponse;
  206. var
  207.    saveit : TResponse;
  208. begin
  209.   saveit := yes;
  210.   if SaveDialog.Execute then
  211.   begin
  212.    if FileExists(SaveDialog.FileName) then
  213.    saveit := ConfirmFileSave(SaveDialog.FileName, FILEOVERWRITEMSG);
  214.    if saveit = yes then
  215.     begin
  216.        SetFileName(SaveDialog.FileName);
  217.        DoSaveFile;
  218.     end;
  219.   end
  220.   else saveit := cancel;
  221.   result := saveit;
  222. end;
  223.  
  224. function TMainForm.SaveFile : TResponse;
  225. var
  226.    saveit : TResponse;
  227. begin
  228.   saveit := yes;
  229.   if FFileName = NEWFILENAME then
  230.     saveit := SaveFileAs
  231.   else
  232.     DoSaveFile;
  233.   result := saveit;
  234. end;
  235. // --- End Save/Load Routines
  236.  
  237.  
  238. //-------------------------------
  239. // --- Find and Replace Routines
  240. //-------------------------------
  241. function TMainForm.SearchOptions( dlg : TFindDialog ) : TSearchTypes;
  242. var
  243.   opts : TSearchTypes;
  244. begin
  245.    opts := [];
  246.    if frWholeWord in dlg.Options then opts := opts + [stWholeWord];
  247.    if frMatchCase in dlg.Options then opts := opts + [stMatchCase];
  248. end;
  249.  
  250. function TMainForm.StrFoundAt( dlg : TFindDialog; Opts : TSearchTypes ) : LongInt;
  251. // this is adapted from Borland's code (in help)
  252. var
  253.   FoundAt: LongInt;
  254.   StartPos, ToEnd: integer;
  255. begin
  256.   with EditWin do
  257.   begin
  258.     // begin the search after the current selection if there is one
  259.     // otherwise, begin at the start of the text }
  260.     if SelLength <> 0 then
  261.       StartPos := SelStart + SelLength
  262.     else
  263.       StartPos := 0;
  264.     // ToEnd is the length from StartPos to the end of the text
  265.     // in the rich edit control
  266.     ToEnd := Length(Text) - StartPos;
  267.     FoundAt := FindText(dlg.FindText, StartPos, ToEnd, Opts );
  268.     result := FoundAt;
  269.   end;
  270. end;
  271.  
  272.  
  273. function TMainForm.ReplaceStr( dlg : TReplaceDialog ) : boolean;
  274. var
  275.    FoundAt : LongInt;
  276. begin
  277.    FoundAt := StrFoundAt( dlg, SearchOptions(dlg) );
  278.    if FoundAt <> -1 then
  279.    begin
  280.      EditWin.SetFocus;
  281.      // Select text --- same code as in FindStr()
  282.      EditWin.SetFocus;
  283.      EditWin.SelStart := FoundAt;
  284.      EditWin.SelLength := Length(dlg.FindText);
  285.     // Replace it
  286.       EditWin.SelText := dlg.ReplaceText;
  287.      // show selection
  288.       EditWin.SelStart := FoundAt;
  289.       EditWin.SelLength := Length(dlg.ReplaceText);
  290.     end;
  291.     if FoundAt <> -1 then
  292.        result := true
  293.     else
  294.        result := false; // ret true if a replacement was made
  295. end;
  296.  
  297. procedure TMainForm.FindStr( dlg : TFindDialog );
  298. var
  299.    FoundAt : LongInt;
  300. begin
  301.    FoundAt := StrFoundAt( dlg, SearchOptions(dlg) );
  302.    if FoundAt <> -1 then
  303.    begin
  304.      EditWin.SetFocus;
  305.      EditWin.SelStart := FoundAt;
  306.      EditWin.SelLength := Length(dlg.FindText);
  307.    end
  308.    else MessageDlg('No match found', mtInformation, [mbOk], 0 );
  309. end;
  310. // --- end Find and Replace routines
  311.  
  312.  
  313. //-------------------------------
  314. // --- general utilty routines
  315. //-------------------------------
  316. procedure TMainForm.SetFileName( fn : string );
  317. begin
  318.    FFileName := fn;
  319.    Caption := Format('%s : [%s]', [APPNAME,ExtractFileName(fn)]);
  320. end;
  321.  
  322. procedure TMainForm.ClearEditWin;
  323. // Clear out edit window and change various elements of the
  324. // environment as appropriate.
  325. begin
  326.   EditWin.Lines.Clear;
  327.   EditWin.Modified := False;
  328.   SetFileName(NEWFILENAME);
  329. end;
  330. // --- end general utility routines
  331.  
  332. //-------------------------------
  333. // --- Font and Character
  334. // --- style routines
  335. //-------------------------------
  336. procedure TMainForm.UpdateFontDisplay;
  337. var
  338.    i, fontindex : integer;
  339.    SelectedText :  TTextAttributes;
  340.    currCol : TColor;
  341.    colindex : integer;
  342. begin
  343.    SelectedText := EditWin.SelAttributes;
  344. // FONT
  345.    // font combo
  346.    fontindex := FontCombo.Items.IndexOf(SelectedText.Name);
  347.    if fontindex <> -1 then
  348.       FontCombo.ItemIndex := fontindex
  349.    else
  350.       FontCombo.ItemIndex := 0;
  351.    // size combo
  352.    FontSizeCombo.Text := IntToStr(SelectedText.Size);
  353.    // colour combo
  354.    currCol := SelectedText.Color;
  355.    colindex := 0;
  356.    for i := Low(Colours) to High(Colours) do
  357.        if Colours[i].Value = currCol then colindex := i;
  358.    ColourCombo.ItemIndex := colindex;
  359.    //=================
  360. // STYLES
  361.    BoldBtn.Down := fsBold in SelectedText.Style;
  362.    ItalicBtn.Down := fsItalic in SelectedText.Style;
  363.    ULineBtn.Down := fsUnderline in SelectedText.Style;
  364. end;
  365.  
  366.  
  367. procedure TMainForm.ToggleBold;
  368. // note the Style property of Tool buttons must be tbsCheck in order
  369. // that they stay down when clicked.
  370. var
  371.    SelectedText : TTextAttributes;
  372. begin
  373.   SelectedText := EditWin.SelAttributes;
  374.   if BoldBtn.Down then
  375.     SelectedText.Style := SelectedText.Style + [fsBold]
  376.   else
  377.     SelectedText.Style := SelectedText.Style - [fsBold];
  378. end;
  379.  
  380. procedure TMainForm.ToggleItalic;
  381. var
  382.    SelectedText : TTextAttributes;
  383. begin
  384.   SelectedText := EditWin.SelAttributes;
  385.   if ItalicBtn.Down then
  386.     SelectedText.Style := SelectedText.Style + [fsItalic]
  387.   else
  388.     SelectedText.Style := SelectedText.Style - [fsItalic];
  389. end;
  390.  
  391. procedure TMainForm.ToggleULine;
  392. var
  393.    SelectedText : TTextAttributes;
  394. begin
  395.   SelectedText := EditWin.SelAttributes;
  396.   if ULineBtn.Down then
  397.     SelectedText.Style := SelectedText.Style + [fsUnderline]
  398.   else
  399.     SelectedText.Style := SelectedText.Style - [fsUnderline];
  400. end;
  401.  
  402. // --- End Font and Character style routines
  403.  
  404.  
  405. // ===================================================
  406. // =========== DELPHI-Managed Event Handlers  ========
  407. // ===================================================
  408.  
  409. //-------------------------------
  410. // --- Menus
  411. //-------------------------------
  412. procedure TMainForm.NewMenuItemClick(Sender: TObject);
  413. begin
  414.    if OKtoCloseCurrentDoc then
  415.       ClearEditWin;
  416. end;
  417.  
  418. procedure TMainForm.OpenMenuItemClick(Sender: TObject);
  419. begin
  420.    if OKtoCloseCurrentDoc then
  421.    if OpenDialog.Execute then
  422.    if not(FileExists(OpenDialog.FileName)) then
  423.       MessageDlg(Format('Cannot open! %s not found.',[ExtractFileName(OpenDialog.FileName)]),
  424.       mtInformation, [mbOK], 0)
  425.    else
  426.    begin
  427.      EditWin.Lines.LoadFromFile(OpenDialog.FileName);
  428.      SetFileName(OpenDialog.FileName);
  429.      EditWin.SetFocus;
  430.      EditWin.Modified := False;
  431.      UpdateFontDisplay;
  432.   end;
  433. end;
  434.  
  435. procedure TMainForm.ExitMenuItemClick(Sender: TObject);
  436. begin
  437.    Close;
  438. end;
  439.  
  440. procedure TMainForm.SaveMenuItemClick(Sender: TObject);
  441. begin
  442.    SaveFile;
  443. end;
  444.  
  445. procedure TMainForm.SaveAsMenuItemClick(Sender: TObject);
  446. begin
  447.    SaveFileAs;
  448. end;
  449.  
  450. procedure TMainForm.CutMenuItemClick(Sender: TObject);
  451. begin
  452.    EditWin.CutToClipboard;
  453. end;
  454.  
  455. procedure TMainForm.CopyMenuItemClick(Sender: TObject);
  456. begin
  457.    EditWin.CopyToClipboard;
  458. end;
  459.  
  460. procedure TMainForm.PasteMenuItemClick(Sender: TObject);
  461. begin
  462.    EditWin.PasteFromClipboard;
  463. end;
  464.  
  465. procedure TMainForm.UndoMenuItemClick(Sender: TObject);
  466. begin
  467.    EditWin.Undo;
  468. end;
  469.  
  470. procedure TMainForm.FindMenuItemClick(Sender: TObject);
  471. begin
  472.   FindDialog.Execute;
  473. end;
  474.  
  475. procedure TMainForm.ReplaceMenuItemClick(Sender: TObject);
  476. begin
  477.    ReplaceDialog.Execute;
  478. end;
  479.  
  480. procedure TMainForm.FontMenuItemClick(Sender: TObject);
  481. begin
  482.   // show currently selected editor font in Font dialog
  483.    FontDialog.Font.Assign(EditWin.SelAttributes);
  484.   // then execute FontDialog and apply chosen font (if there is one)
  485.   if FontDialog.Execute then
  486.   begin
  487.      EditWin.SelAttributes.Assign(FontDialog.Font);
  488.        // make sure that SelectionChange() updates font combo etc.
  489.      UpdateFontDisplay;
  490.   end;
  491. end;
  492. // --- End Menus
  493.  
  494. //-------------------------------
  495. // --- Find & Replace Dialogs
  496. //-------------------------------
  497. procedure TMainForm.ReplaceDialogReplace(Sender: TObject);
  498. var
  499.    repcount : integer;
  500.    dlg : TReplaceDialog;
  501. begin
  502.    repcount := 0;
  503.    dlg := TReplaceDialog( Sender );
  504.    if frReplaceAll in dlg.Options then
  505.    begin
  506.       while ReplaceStr( dlg ) do
  507.             INC(repcount);
  508.       ShowMessage( IntToStr(repcount) + ' replacements made.' );
  509.    end
  510.    else
  511.       if not ReplaceStr( dlg ) then
  512.          MessageDlg('No match found', mtInformation, [mbOk], 0 );
  513. end;
  514.  
  515. procedure TMainForm.FindDialogFind(Sender: TObject);
  516. // This is shared by Replace and Find dialog
  517. begin
  518.    FindStr( TFindDialog(Sender) );
  519. end;
  520. // --- End Find & Replace Dialogs
  521.  
  522.  
  523. //-------------------------------
  524. // --- COMBO BOXES
  525. //-------------------------------
  526.  
  527. // --- Font Combo Box ---
  528. procedure TMainForm.FontComboDrawItem(Control: TWinControl; Index: Integer;
  529.   Rect: TRect; State: TOwnerDrawState);
  530. begin
  531.   with FontCombo.Canvas do
  532.   begin
  533.     FillRect(Rect);
  534.     Font.Name := FontCombo.Items[Index];
  535.     Font.Size := 12;
  536.     TextOut(Rect.Left, Rect.Top, FontCombo.Items[Index]);
  537.   end;
  538. end;
  539.  
  540. procedure TMainForm.ShowFontStylesCBClick(Sender: TObject);
  541. begin
  542.     if ShowFontStylesCB.checked then
  543.        FontCombo.Style := csOwnerDrawFixed
  544.     else
  545.        FontCombo.Style := csDropDownList;
  546. end;
  547.  
  548. procedure TMainForm.FontComboChange(Sender: TObject);
  549. begin
  550.    EditWin.SelAttributes.Name := FontCombo.Items[FontCombo.ItemIndex];
  551.    EditWin.SetFocus;
  552. end;
  553.  
  554. // --- FontSize Combo ---
  555. procedure TMainForm.FontSizeComboClick(Sender: TObject);
  556. // mouse click selection of font size
  557. begin
  558.    EditWin.SetFocus;
  559. end;
  560.  
  561. procedure TMainForm.FontSizeComboExit(Sender: TObject);
  562. // deal with manual editing of the Font size
  563. var
  564.   fsize : integer;
  565. begin
  566.   fsize := StrToIntDef(FontSizeCombo.Text, -1);
  567.   if fsize < 1 then
  568.   begin
  569.       MessageDlg(Format('Invalid Font size: %s.',[FontSizeCombo.Text]),
  570.       mtInformation, [mbOK], 0);
  571.       UpdateFontDisplay;    // redisplay valid values in combos
  572.   end
  573.   else
  574.   begin
  575.      EditWin.SelAttributes.Size := StrToInt(FontSizeCombo.Text);
  576.      EditWin.SetFocus;
  577.   end;
  578. end;
  579.  
  580. procedure TMainForm.FontSizeComboKeyUp(Sender: TObject; var Key: Word;
  581.   Shift: TShiftState);
  582. begin
  583.    // if Enter is pressed, focus editwin
  584.    if Key = 13 then
  585.       EditWin.SetFocus;
  586. end;
  587.  
  588. procedure TMainForm.FontSizeComboKeyPress(Sender: TObject; var Key: Char);
  589. begin
  590. // without this, you'll hear an annoying 'ping!' when the Enter key is pressed
  591.    if Key = #13 then Key := #0;
  592. end;
  593.  
  594.  
  595. // --- ColourCombo ---
  596. procedure TMainForm.ColourComboDrawItem(Control: TWinControl;
  597.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  598.   // Handle drawing of item that's selected on drop down
  599. begin
  600.   with ColourCombo.Canvas do
  601.   begin
  602.     FillRect(Rect);
  603.     Brush.Color := TColor(Colours[Index].Value);
  604.     TextOut(Rect.Left, Rect.Top, COLOURBLOB);
  605.    // ====
  606.     Brush.Style := bsClear;
  607.     TextOut(PenPos.X, Rect.Top, ' ' + Colours[Index].Name ); 
  608.   end;
  609. end;
  610.  
  611.  
  612. procedure TMainForm.ColourComboChange(Sender: TObject);
  613. begin
  614. //   This assumes that the index to items in Colours and ColourCombo is the same
  615.    EditWin.SelAttributes.Color := Colours[ColourCombo.ItemIndex].Value;
  616.    EditWin.SetFocus;
  617. end;
  618. // --- End Combo Boxes
  619.  
  620. // -------------------------
  621. // --- ToolButtons
  622. // -------------------------
  623. procedure TMainForm.BoldBtnClick(Sender: TObject);
  624. begin
  625.    ToggleBold;
  626. end;
  627.  
  628. procedure TMainForm.ItalicBtnClick(Sender: TObject);
  629. begin
  630.    ToggleItalic;
  631. end;
  632.  
  633. procedure TMainForm.ULineBtnClick(Sender: TObject);
  634. begin
  635.    ToggleULine;
  636. end;
  637. // --- End ToolButtons
  638.  
  639.  
  640. // -------------------------
  641. // --- EditWin
  642. // -------------------------
  643. procedure TMainForm.EditWinKeyUp(Sender: TObject; var Key: Word;
  644.   Shift: TShiftState);
  645. var
  646.    SelectedText : TTextAttributes;
  647. begin
  648.   SelectedText := EditWin.SelAttributes;
  649.  // Bold
  650.   if (ssCtrl in Shift) and (upcase(chr(Key)) = 'B') then
  651.         if fsBold in SelectedText.Style then
  652.            SelectedText.Style := SelectedText.Style - [fsBold]
  653.         else
  654.            SelectedText.Style := SelectedText.Style + [fsBold];
  655.  // Italic
  656.   if (ssCtrl in Shift) and (upcase(chr(Key)) = 'I') then
  657.         if fsItalic in SelectedText.Style then
  658.            SelectedText.Style := SelectedText.Style - [fsItalic]
  659.         else
  660.            SelectedText.Style := SelectedText.Style + [fsItalic];
  661.  // Underline
  662.   if (ssCtrl in Shift) and (upcase(chr(Key)) = 'U') then
  663.         if fsUnderline in SelectedText.Style then
  664.            SelectedText.Style := SelectedText.Style - [fsUnderline]
  665.         else
  666.            SelectedText.Style := SelectedText.Style + [fsUnderline];
  667.   UpdateFontDisplay;
  668. end;
  669.  
  670. procedure TMainForm.EditWinKeyPress(Sender: TObject; var Key: Char);
  671. begin
  672.   if Key = #9 then Key := #0;
  673. end;
  674.  
  675. procedure TMainForm.EditWinSelectionChange(Sender: TObject);
  676. begin
  677.    UpdateFontDisplay;
  678. end;
  679.  
  680. // -------------------------
  681. // --- FORM Create and Close
  682. // -------------------------
  683. procedure TMainForm.FormCreate(Sender: TObject);
  684. var
  685.    i : integer;
  686. begin
  687.    ClearEditWin;
  688.    EditWin.HideSelection := false; // show selection when EditWin loses focus
  689. // init FontCombo
  690.   with FontCombo do
  691.   begin
  692.      Items := Screen.Fonts;
  693.      ItemHeight := 20;
  694.      Style := csDropDown;
  695.   end;
  696. // init FontSize combo
  697.   with FontSizeCombo do
  698.   begin
  699.      Style := csDropDown;
  700.      for i := 0 to High(FontSizes) do
  701.          Items.Add(IntToStr(FONTSIZES[i]));
  702.   end;
  703. // init ColourCombo
  704.    with ColourCombo do
  705.    begin
  706.      Style := csOwnerDrawVariable;
  707.    for i := Low(Colours) to High(Colours) do
  708.          Items.Add(COLOURBLOB + Colours[i].Name);
  709.    end;
  710.   UpdateFontDisplay;    // indicate Font details in tools and combos of toolbar
  711. end;
  712.  
  713. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  714. begin
  715.    if OKtoCloseCurrentDoc then
  716.       CanClose := true
  717.    else
  718.       CanClose := false;
  719. end;
  720.  
  721.  
  722. end.
  723.